home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / utils / cat.arc / CAT.MOD < prev    next >
Text File  |  1987-01-27  |  9KB  |  222 lines
  1. MODULE Cat; (* send a file to printer or screen *)
  2. FROM InOut IMPORT ReadString, EOL, Done, OpenInputFile,
  3.      CloseInput, Read, Write, WriteLn, WriteString, WriteInt;
  4. FROM Streams IMPORT Stream, StreamKinds, OpenStream, CloseStream, EOS;
  5. FROM TextIO IMPORT WRite, WRiteLn, WRiteString, WRiteInt, WRiteCard, REad;
  6. FROM AESForms IMPORT FileSelectorInput, FormAlert;
  7. FROM GEMDOS IMPORT OldTerm, GetDrv, SetDrv, NecIn;
  8. FROM MyFiles IMPORT SelectFile, NewPath;
  9. FROM Environment IMPORT OpenAppl, CloseAppl, CursorOn, CursorOff;
  10. FROM VDIEscapes IMPORT ReverseVideoOn, ReverseVideoOff, CursorAddress;
  11. IMPORT ASCII;
  12. FROM Clock IMPORT FindDate, FindTime;
  13. CONST MaxInt = 32767;
  14.       TABS = "(008,016,024,032,040,048,056,064,072."; (* for Itoh 8510 *)
  15.       Version =
  16. "[2][WLS Cat Ver. 0.6|developed with TDI/Modula-2||output to:][printer|screen|file]";
  17.       NoEpson =
  18. "[1][Epson and compatible printers:|no initialization procedure yet][none]";
  19.  
  20. TYPE OutputDevice = (printer, screen, file);
  21.      Status = (normal, cr, lf); (* for endline handling *)
  22.      PrinterType = (unknown, itoh, epson, none);
  23. VAR c : CHAR;
  24.      path, newfile : ARRAY [0..64] OF CHAR;
  25.      Ext : ARRAY [0..3] OF CHAR;
  26.      PageSize, PageNumber, i, column, dot, wh, width, line : INTEGER;
  27.      year, month, day, hour, min, sec, Drive : CARDINAL;
  28.      dummy : LONGCARD;
  29.      InStream, OutStream : Stream;
  30.      Device : OutputDevice;
  31.      Printer : PrinterType;
  32.      Pause, KeepGoing : BOOLEAN;
  33.      lastchar : Status;
  34.  
  35. PROCEDURE Cls; (* clear the screen, home the cursor *)
  36. BEGIN
  37.      Write(ASCII.ESC); Write('E');
  38. END Cls;
  39.  
  40. PROCEDURE Wrap; (* finish up and exit gracefully *)
  41. BEGIN
  42.      CursorOn; CloseAppl(wh); OldTerm(); (* KeepGoing := FALSE *)
  43. END Wrap;
  44.  
  45. PROCEDURE PutByte(ch : CHAR);
  46. BEGIN
  47.     WRite(OutStream, ch);
  48.     INC(column);
  49. END PutByte;
  50.  
  51. PROCEDURE NewLine;
  52. BEGIN
  53.     WRiteLn(OutStream);
  54.     IF Device # screen
  55.     THEN Write('.'); INC(dot); (* dot serves as a counter *)
  56.          IF dot > 78 THEN WriteLn; dot := 0 END;
  57.     END; (* something to watch *)
  58.     column := 0; INC(line);
  59. END NewLine;
  60.  
  61. PROCEDURE Header; (* used for printer only *)
  62. BEGIN
  63.     WRiteLn(OutStream);
  64.     WRiteString(OutStream, path); WRiteString(OutStream, "  --  ");
  65.     IF year > 85 THEN
  66.        WRiteCard(OutStream, year,2); WRite(OutStream, '/');
  67.        WRiteCard(OutStream, month,1); WRite(OutStream, '/');
  68.        WRiteCard(OutStream, day,1); WRiteString(OutStream, '  ');
  69.        WRiteCard(OutStream, hour,2); WRite(OutStream, ':');
  70.        IF min < 10 THEN WRite(OutStream, '0'); WRiteCard(OutStream, min, 1);
  71.        ELSE WRiteCard(OutStream, min, 2) END;
  72.        WRiteString(OutStream, "  --  ");
  73.     END;
  74.     WRiteString(OutStream, "Page ");
  75.     WRiteInt(OutStream, PageNumber, 1);
  76.     WRiteLn(OutStream); WRiteLn(OutStream); (* now write to screen --  *)
  77.     WriteLn; WriteString("Page "); WriteInt(PageNumber, 2); (* display *)
  78.     line := 12; column :=0; INC(PageNumber);
  79. END Header;
  80.  
  81. PROCEDURE pass;  (* process and output a character *)
  82. BEGIN
  83.         CASE c OF
  84.         34C..36C, 40C : PutByte(' '); lastchar := normal |
  85.         ASCII.CR : IF lastchar # lf THEN NewLine; lastchar := cr; END |
  86.         ASCII.LF : IF lastchar # cr THEN NewLine; lastchar := lf; END |
  87.     (*  0C : NewLine; lastchar := normal | STW EOL *)
  88.         ELSE PutByte(c); lastchar := normal
  89.         END;
  90.         IF column >= width THEN NewLine END;
  91.         IF EOS(InStream) THEN Done := FALSE; (* for InOut compatibility *)
  92.         ELSIF line > PageSize THEN
  93.            CASE Device OF
  94.            printer : PutByte(ASCII.FF); Header |
  95.            screen  : ReverseVideoOn(wh);
  96.                      WriteString("---More---");
  97.                      ReverseVideoOff(wh);
  98.                      NecIn(c);
  99.                      Write(ASCII.ESC); Write('l'); (* erase line *)
  100.                      column := 0;
  101.                      CASE c OF
  102.                      'q', 'Q' : Done := FALSE; Pause := FALSE |
  103.                      'a', 'A' : Done := FALSE; Pause := FALSE;
  104.                                 KeepGoing := FALSE |
  105.                      EOL : DEC(line) |
  106.                      '1'..'9' : DEC(line, ORD(c) - ORD('0')) |
  107.                      '?', 'h', 'H' : WriteLn; (* HELP menu *)
  108.                          WriteString("Commands are:"); WriteLn;
  109.                          WriteString(
  110.                            "SPACE for next page, RETURN for next line");
  111.                          WriteLn;
  112.                          WriteString(
  113.                            "Q quits this file, A aborts the program");
  114.                          WriteLn;
  115.                          WriteString(
  116.                            "Enter a digit n to see the next n lines");
  117.                           WriteLn;
  118.                          c := ' '; pass
  119.                      ELSE line := 0
  120.                      END |
  121.            file : (* no processing in this case *)
  122.            END
  123.         END;
  124. END pass;
  125.  
  126. PROCEDURE OpenDevice() : BOOLEAN ;
  127. BEGIN
  128.         CursorOff; Cls; CursorAddress(wh, 12, 40); CursorOn;
  129.         i:=FormAlert(1, Version) - 1 ;
  130.         Device := VAL( OutputDevice, i );
  131.         Pause := FALSE;
  132.         CursorOff; Cls; CursorAddress(wh, 12, 40); CursorOn;
  133.         CASE Device OF
  134.            printer : OpenStream(OutStream, "PRN:", READWRITE, i);
  135.                      IF i<0 THEN RETURN FALSE; END;
  136.                      IF Printer = unknown
  137.                      THEN i := FormAlert(3,
  138.                             "[2][Printer Initialization][Itoh|Epson|none]");
  139.                           Printer := VAL(PrinterType, i);
  140.                           CASE Printer OF
  141.                           itoh  : WRite(OutStream, ASCII.ESC);
  142.                                   WRiteString(OutStream, TABS) |
  143.                           epson : CursorOff; Cls; CursorAddress(wh, 12, 40);
  144.                                   CursorOn; i := FormAlert(1, NoEpson) |
  145.                           none  :
  146.                           END;
  147.                           CursorOff;
  148.                      END;
  149.                      PageSize := 66; width := 80;
  150.                      CursorOff; Cls;
  151.                      WriteString("Printing ");
  152.                      WriteString(path); WriteLn;
  153.                      PageNumber := 1; Header |
  154.            screen  : OpenStream(OutStream, "CON:", READWRITE, i);
  155.                      IF i<0 THEN RETURN FALSE; END;
  156.                      PageSize := 23; width := 79 (* avoid auto-wrap *);
  157.                      line := 0; column := 0; Pause := TRUE;
  158.                      CursorOff; Cls |
  159.            file    : newfile := path;
  160.                      CursorAddress(wh, 2, 21); ReverseVideoOn(wh);
  161.                      WriteString("Select OUTPUT File...");
  162.                      ReverseVideoOff(wh); CursorOff;
  163.                      CursorAddress(wh, 12, 40); CursorOn;
  164.                      Ext := '*'; NewPath(newfile, Ext);
  165.                      IF NOT SelectFile(newfile) THEN Wrap END;
  166.                      OpenStream(OutStream, newfile, READWRITE, i);
  167.                      IF i<0 THEN RETURN FALSE; END;
  168.                      PageSize := MaxInt;
  169.                      width := MaxInt; line := 0; column := 0;
  170.                      CursorOff; Cls;
  171.                      WriteString("Copying ");
  172.                      WriteString(path);
  173.                      WriteString(" to ");
  174.                      WriteString(newfile);
  175.                      WriteLn |
  176.         END;
  177.         RETURN TRUE
  178. END OpenDevice;
  179.  
  180. BEGIN
  181. Printer := unknown;
  182. path := "A:\*.*";
  183. OpenAppl(wh);
  184.  
  185. KeepGoing := TRUE; (* flag used by both PRG and ACC versions *)
  186. FindDate(year, month, day); FindTime(hour, min, sec); (* for print header *)
  187. INC(year, 80);
  188. WHILE KeepGoing DO
  189.       GetDrv(Drive);
  190.       path[0] := CHR( ORD('A') + Drive );
  191.       Ext := "*"; NewPath(path, Ext); (* Ext is a 1-char string *)
  192.       CursorOff; Cls; CursorAddress(wh, 2, 21); ReverseVideoOn(wh);
  193.       WriteString("CAT by WLS: Select INPUT File...");
  194.       ReverseVideoOff(wh); CursorAddress(wh, 12, 40); CursorOn;
  195.       IF SelectFile(path)
  196.       THEN SetDrv(ORD(path